home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
VGA_VUL5.ZIP
/
STARS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1995-10-20
|
4KB
|
156 lines
{ === Example of a 3d-starfield in Pascal. By Vulture / Outlaw Triad === }
Program StarField3D;
Uses Crt;
Type StarFormat = Record { Format of star }
X, Y, Z: Integer; { 3d = x,y,z }
OX, OY: Integer; { 2d = x,y (here for deletion) }
Color: Byte;
End;
Const VGA = $A000; { VGA-segment }
MaxStars = 350; { Guess what? ;-) }
Xoff = 160; { Used for calculating vga-pos }
Yoff = 100;
Zoff = 255; { Stars are way deep in space }
WarpSpeed = 1; { Speed of stars }
Var Stars: Array[1..MaxStars] of StarFormat; { Array to hold all data }
Loop1: Integer; { Used in 2 routines }
Procedure VideoMode(Mode: Byte); Assembler;
Asm
mov ah,00
mov al,Mode
int 10h
End;
Procedure SetPixel(X,Y:Integer;Color:Byte;Where:Word); Assembler;
Asm { TP automatically pushes and pops ES }
mov ax,[Where] { Move destination in AX }
mov es,ax { es => points to VGA or virtual screen }
mov di,Y { Move Y into DI }
mov ax,Y { Move Y into AX }
shl di,8 { DI := DI * 256 }
shl ax,6 { AX := AX * 64 }
add di,ax { DI := Y * 320 }
mov ax,X { Move X into AX }
add di,ax { DI = X + Y final location }
mov al,Color { Set color }
mov byte ptr es:[di],al { Place the dot }
End;
Procedure SetColor(Color,R,G,B: Byte);
Begin
asm
mov dx,3C8h
mov al,[Color]
out dx,al
inc dx
mov al,[R]
out dx,al
mov al,[G]
out dx,al
mov al,[B]
out dx,al
end;
End;
Procedure WaitRetrace; Assembler; { Waits for Vertical Retrace }
label l1, l2;
Asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
End;
Procedure EditPalette; { Change palette for starfield }
Var Number, C: Integer;
Begin
C := 10;
For Number := 1 to 5 Do
Begin
SetColor(Number,C,C,C);
INC(C,10);
End;
End;
Procedure InitializeStars; { Init all stars here }
Var Loop1: Integer;
Begin
For Loop1 := 1 to MaxStars Do
Begin
Stars[loop1].X:=Random(320)-160;
Stars[loop1].Y:=Random(200)-100;
Stars[loop1].Z:=Random(255);
End;
End;
Procedure CreateStar(A: Integer); { If star was aborted, create a new one }
Begin
Stars[A].X := Random(320)-160;
Stars[A].Y := Random(200)-100;
Stars[A].Z := Zoff;
End;
Procedure Color(A: Integer); { Get color for star (ugly code!) }
Begin
Case A Of
1..50 : Stars[Loop1].Color := 5;
51..100 : Stars[Loop1].Color := 4;
101..150 : Stars[Loop1].Color := 3;
151..200 : Stars[Loop1].Color := 2;
201..255 : Stars[Loop1].Color := 1;
End;
End;
Procedure CalcStars;
Var NX,NY: Integer;
Begin
For Loop1 := 1 to MaxStars Do
Begin
If Stars[Loop1].Z > 0 then
Begin
NX := ((Stars[Loop1].X shl 7) div Stars[Loop1].Z) + Xoff;
NY := ((Stars[Loop1].Y shl 7) div Stars[Loop1].Z) + Yoff;
If (NX > 0) AND (NX < 320) AND (NY > 0) AND (NY < 200) Then
Begin
Color(Stars[Loop1].Z);
SetPixel(NX, NY, Stars[Loop1].Color, VGA);
Stars[Loop1].OX := NX;
Stars[Loop1].OY := NY;
Dec(Stars[Loop1].Z,WarpSpeed); { Go towards viewer }
End
Else CreateStar(Loop1); { Not in VGA-range ... create new star }
End
Else CreateStar(Loop1); { Reached Z = 0 ... create new star }
End;
End;
Procedure DeleteStars; { Delete all stars at once }
Var Loop1: Integer;
Begin
For Loop1 := 1 to MaxStars Do SetPixel(Stars[Loop1].OX, Stars[Loop1].OY, 0, VGA);
End;
Begin
RandoMize; { Truly random }
VideoMode($13);
InitializeStars;
EditPalette;
Repeat
CalcStars; { Improve and show new stars }
WaitRetrace;
DeleteStars; { Delete them stars }
Until KeyPressed;
VideoMode($3);
Writeln('Code by Vulture / Outlaw Triad'); { Who's done it ? }
End.